unit MyAspell;
{
/*
  Aspell helper class
  Copyright (c) Andrzej Oczkowicz, 2009
  License GNU GPL v. 2
*/
}

interface

uses
  AspellHeadersDyn, SysUtils, Classes, INIFiles;

type
  TASpell = class
  private
    library_name, error_msg:string;
    cfg : AspellConfig;
    speller : AspellSpeller;
    ini:TINIFile;


    FLoaded: boolean;
    FDicts, ConfigKeys: TStringList;
    FConfigFile: string;
    function GetLang: string;
    procedure SetLang(const Value: string);
    function GetDicts: TStringList;

    procedure RecreateSpeller();
    procedure CreateConfig(const ConfigFile:string);

  public
    constructor Create();
    destructor Destroy(); override;

    function WordOk(const word:string):boolean;
    procedure WordSuggestions(const word:string; list:TStrings);
    procedure WordAdd(const word:string);
    procedure UnLoad();
    function Load(const LibraryName, ConfigFile:string):boolean;
    function Error():string;
    function GetConfigValue(const key:string):string;
    function GetConfigValueInt(const key:string):integer;
    function GetConfigValueBool(const key:string):Boolean;
    procedure GetConfigValueList(const key:string; list:TStrings);

    function SetConfigValue(const key, value:string):boolean;
    function SetConfigValueInt(const key:string; val:integer):boolean;
    function SetConfigValueBool(const key:string; val:boolean):boolean;
    function SetConfigValueList(const key:string; val:TStrings):boolean;

    function GetConfigKeyInfo(const key:string):AspellKeyInfo;
    procedure GetConfigKeys(list:TStrings);


    property Loaded:boolean read FLoaded;
    property Dicts:TStringList read GetDicts;
    property Lang:string read GetLang write SetLang;
    property ConfigFile: string read FConfigFile;
  end; 



implementation

{ TASpell }

constructor TASpell.Create;
begin
  FDicts      := TStringList.Create;
  ConfigKeys  := TStringList.Create;
end;

procedure TASpell.CreateConfig(const ConfigFile: string);
var
  List:TStringList;
  i:integer;
  v:string;
begin
  ini := TINIFile.Create(ConfigFile);
  List := TStringList.Create;
  try
    ini.ReadSections(list);
    for i:=0 to list.Count-1 do
      begin
        v := ini.ReadString(list[i], 'Value', '');
        if Assigned(cfg) then
          aspell_config_replace(cfg, pchar(list[i]), pchar(v));
      end;
  finally
    List.Free;
  end;
end;

destructor TASpell.Destroy;
begin
  FDicts.Free;
  ConfigKeys.Free;
  UnLoad();
end;

function TASpell.Error: string;
begin
  Result := error_msg;
end;


function TASpell.GetConfigKeyInfo(const key: string): AspellKeyInfo;
begin
  Result := aspell_config_keyinfo(cfg, pchar(key));
end;

procedure TASpell.GetConfigKeys(list: TStrings);
var
  key_info_elements : AspellKeyInfoEnumeration;
  key_info : AspellKeyInfo;
begin
  if not Assigned(list) or not Assigned(cfg) then
    exit;
  key_info_elements := aspell_config_possible_elements(cfg, 0);
  repeat
    key_info := aspell_key_info_enumeration_next( key_info_elements );
    if (key_info = nil) then
      break;
    List.Add(key_info.name);
// FIXME: aspell_key_info_enumeration_at_end() doesn't work. workaround: key_info=NIL -> break
  until (aspell_key_info_enumeration_at_end(key_info_elements) <> 0);
end;

function TASpell.GetConfigValue(const key: string): string;
begin
  if Assigned(cfg) then
    Result := aspell_config_retrieve(cfg, pchar(key))
  else
    Result := '';
end;

function TASpell.GetConfigValueBool(const key: string): Boolean;
begin
  if Assigned(cfg) then
    Result := aspell_config_retrieve_bool(cfg, pchar(key)) <> 0
  else
    Result := false;
end;

function TASpell.GetConfigValueInt(const key: string): integer;
begin
  if Assigned(cfg) then
    Result := aspell_config_retrieve_int(cfg, pchar(key))
  else
    Result := 0;
end;

procedure TASpell.GetConfigValueList(const key: string; list: TStrings);
var
  els: AspellStringEnumeration;
  lst: AspellStringList;
  lst0:AspellMutableContainer;
  val:pchar;
begin
  if not assigned(cfg) or not assigned(list) then
    exit;
  lst  := new_aspell_string_list();
  lst0 := aspell_string_list_to_mutable_container(lst);
  aspell_config_retrieve_list(cfg, pchar(key), lst0);
  els := aspell_string_list_elements(lst);
  list.Clear;
  repeat
    val := aspell_string_enumeration_next(els);
    list.Add(val);
  until val = nil;
  delete_aspell_string_enumeration(els);
  delete_aspell_string_list(lst);
end;

function TASpell.GetDicts: TStringList;
var
  dict_info_list : AspellDictInfoList;
  dict_info_elements : AspellDictInfoEnumeration;
  dict_info : TAspellDictInfo;
  dict_inf : AspellDictInfo;
begin
  FDicts.Clear;
  Result := FDicts;
  if not loaded then
    exit;
  dict_info_list := get_aspell_dict_info_list(cfg);
  dict_info_elements := aspell_dict_info_list_elements( dict_info_list );
  repeat
    dict_inf := aspell_dict_info_enumeration_next( dict_info_elements );
    if dict_inf <> nil then
      dict_info := dict_inf^
    else
      continue;
    FDicts.Add( dict_info.name );
  until (aspell_dict_info_enumeration_at_end( dict_info_elements ) <> 0);
  delete_aspell_dict_info_enumeration(dict_info_elements);
end;

function TASpell.GetLang: string;
begin
  if Assigned(cfg) then
    Result := aspell_config_retrieve(cfg, 'lang')
  else
    Result := '';
end;

function TASpell.Load(const LibraryName, ConfigFile:string): boolean;
begin
  UnLoad();
  library_name := LibraryName;
  FLoaded := LoadAspell(LibraryName);
  cfg := new_aspell_config();
  CreateConfig(ConfigFile);
  RecreateSpeller();
  Result := FLoaded and Assigned(speller);
  if not Assigned(speller) then
    UnLoad();
end;


procedure TASpell.RecreateSpeller;
var
  possible_err  : AspellCanHaveError;
begin
  if Assigned(speller) then
    begin
      delete_aspell_speller(speller);
      speller := nil;
    end;
  possible_err := new_aspell_speller(cfg);
  if (aspell_error_number(possible_err) <> 0) then
    begin
      error_msg := aspell_error_message(possible_err);
      exit;
    end;
  speller := to_aspell_speller(possible_err);
  if not Assigned(speller) then
    UnLoad();
end;

function TASpell.SetConfigValue(const key, value: string): boolean;
begin
  if Assigned(cfg) then
    begin
      Result := aspell_config_replace(cfg, pchar(key), pchar(value)) <> 0;
      if result then
        begin
          RecreateSpeller();
          Result := assigned(speller);
        end;
      if ini.FileName <> '' then
        ini.WriteString(key, 'value', value);
    end
  else
    Result := false;
end;

function TASpell.SetConfigValueBool(const key: string;
  val: boolean): boolean;
var
  s:string;
begin
  if val then
    s := '1'
  else
    s := '0';
  Result := SetConfigValue(key, s);
end;

function TASpell.SetConfigValueInt(const key: string;
  val: integer): boolean;
begin
  Result := SetConfigValue(key, IntToStr(val));
end;

function TASpell.SetConfigValueList(const key: string;
  val: TStrings): boolean;
var
  s:string;
  i:integer;
begin
  s := '';
  if Assigned(val) then
    for i:=0 to val.Count-1 do
      s := s + val[i] + ',';
  Delete(s, length(s), 1);
  Result := SetConfigValue(key, s);
end;

procedure TASpell.SetLang(const Value: string);
begin
  if Assigned(cfg) and (value <> lang) then
    begin
      aspell_config_replace(cfg, 'lang', PChar(Value));
      RecreateSpeller();
    end;
end;

procedure TASpell.UnLoad;
begin
  if Loaded then
    begin
      if Assigned(speller) then
        begin
          aspell_speller_save_all_word_lists(speller);
          delete_aspell_speller(speller);
          speller := nil;
        end;
      if Assigned(cfg) then
        begin
          delete_aspell_config(cfg);
          cfg := nil;
        end;
      FLoaded := false;
    end;
  if assigned(ini) then
    FreeAndNil(ini);
end;

procedure TASpell.WordAdd(const word: string);
begin
  if not Assigned(Speller) then
    exit;
  aspell_speller_add_to_personal(Speller, PChar(word), length(word));
  aspell_speller_save_all_word_lists(Speller);
end;

function TASpell.WordOk(const word: string): boolean;
var
  err:integer;
begin
  if Assigned(Speller) then
    begin
      err := aspell_speller_check(Speller, PChar(word), length(word));
      Result := err = 1;
    end
  else
    Result := True;
end;

procedure TASpell.WordSuggestions(const word:string; list:TStrings);
var
  suggestions   : AspellWordList;
  elements      : AspellStringEnumeration;
  word_ : PChar;
begin
  if not assigned(speller) or not assigned(list) or (word = '') then
    exit;
  list.Clear;
  suggestions := aspell_speller_suggest(speller, PChar(Word), length(Word));
  elements := aspell_word_list_elements(suggestions);
  repeat
    word_ := aspell_string_enumeration_next(elements);
  if (word_ <> nil) then
    list.Add(word_);
  until (word_ = nil);
  delete_aspell_string_enumeration(elements);
end;

end.
